home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 001-025 / scopedisk9 / titlebar / pattern < prev   
Encoding:
Text File  |  1995-03-19  |  3.2 KB  |  157 lines
  1. '=======================================
  2.  
  3. '  TitleBarPatterns
  4. '  by Robert L. Barton
  5. '  version 1.1
  6. '  88/01/19
  7.  
  8. '=======================================
  9.  
  10. 'Constants
  11. DEFINT ami, bar, check, diam, heart, pat, quit, sol
  12. pat = 5
  13. bar = 1
  14. diam = 2
  15. heart = 3
  16. sol = 4
  17. check = 5
  18. ami = 6
  19. quit = 7
  20. iName$ = "intuition.library" + CHR$(0)
  21.  
  22. 'Variables
  23. DEFINT item, menuID
  24. DEFLNG iBase, iNamePtr
  25.  
  26. 'Library Functions
  27. DECLARE FUNCTION OpenLibrary& LIBRARY
  28.  
  29. '=======================================
  30.  
  31. LIBRARY "exec.library"
  32. iNamePtr = SADD(iName$)
  33. iBase = OpenLibrary&(iNamePtr, 0)
  34. IF iBase = 0 THEN
  35.   PRINT "Can't open intuition library"
  36.   END
  37. END IF  
  38. MENU pat, 0, 1, "Pattern"
  39. MENU pat, bar,   1, "Bars     "
  40. MENU pat, diam,  1, "Diamonds "
  41. MENU pat, heart, 1, "Hearts   "
  42. MENU pat, sol,   1, "Solid    "
  43. MENU pat, check, 1, "Checks   "
  44. MENU pat, ami,   1, "Amiga A's"
  45. MENU pat, quit,  1, "Quit     "
  46. ON MENU GOSUB CheckMenu
  47. MENU ON
  48. WHILE 1
  49.   SLEEP
  50. WEND
  51.     
  52. CheckMenu:
  53.   menuID = MENU(0)
  54.   IF menuID = pat THEN  'Pattern menu selected 
  55.     item = MENU(1)
  56.     IF item = bar THEN CALL Default
  57.     IF item = diam THEN CALL Diamonds
  58.     IF item = heart THEN CALL Hearts
  59.     IF item = sol THEN CALL Solid
  60.     IF item = check THEN CALL CheckMark
  61.     IF item = ami THEN CALL AmigaA
  62.     IF item = quit THEN
  63.       MENU RESET
  64.       END
  65.     END IF  
  66.   END IF     
  67. RETURN
  68.  
  69. END
  70.  
  71. '=======================================
  72.  
  73. SUB Default STATIC
  74. SHARED iBase
  75.   POKEW iBase + 790, &H0
  76.   POKEW iBase + 792, &H0       
  77.   POKEW iBase + 794, &HFFFF
  78.   POKEW iBase + 796, &HFFFF
  79.   POKEW iBase + 798, &H0
  80.   POKEW iBase + 800, &H0
  81.   POKEW iBase + 802, &HFFFF
  82.   POKEW iBase + 804, &HFFFF
  83. END SUB
  84.  
  85. '=======================================
  86.  
  87. SUB Diamonds STATIC
  88. SHARED iBase
  89.   POKEW iBase + 790, &H0
  90.   POKEW iBase + 792, &H180       
  91.   POKEW iBase + 794, &H3C0
  92.   POKEW iBase + 796, &H7E0
  93.   POKEW iBase + 798, &HFF0
  94.   POKEW iBase + 800, &H7E0
  95.   POKEW iBase + 802, &H3C0
  96.   POKEW iBase + 804, &H180
  97. END SUB
  98.  
  99. '=======================================
  100.  
  101. SUB Hearts STATIC
  102. SHARED iBase
  103.   POKEW iBase + 790, &H0
  104.   POKEW iBase + 792, &HC30       
  105.   POKEW iBase + 794, &H1E78
  106.   POKEW iBase + 796, &H1FF8
  107.   POKEW iBase + 798, &HFF0
  108.   POKEW iBase + 800, &H7E0
  109.   POKEW iBase + 802, &H3C0
  110.   POKEW iBase + 804, &H180
  111. END SUB
  112.  
  113. '=======================================
  114.  
  115. SUB Solid STATIC
  116. SHARED iBase
  117.   POKEW iBase + 790, &HFFFF
  118.   POKEW iBase + 792, &HFFFF       
  119.   POKEW iBase + 794, &HFFFF
  120.   POKEW iBase + 796, &HFFFF
  121.   POKEW iBase + 798, &HFFFF
  122.   POKEW iBase + 800, &HFFFF
  123.   POKEW iBase + 802, &HFFFF
  124.   POKEW iBase + 804, &HFFFF
  125. END SUB
  126.  
  127. '=======================================
  128.  
  129. SUB CheckMark STATIC
  130. SHARED iBase
  131.   POKEW iBase + 790, &HF1FF
  132.   POKEW iBase + 792, &HFFF1
  133.   POKEW iBase + 794, &HFFE7     
  134.   POKEW iBase + 796, &HFFCF
  135.   POKEW iBase + 798, &HFF9F
  136.   POKEW iBase + 800, &HF3F
  137.   POKEW iBase + 802, &HC67F
  138.   POKEW iBase + 804, &HE0FF
  139. END SUB
  140.  
  141. '=======================================
  142.  
  143. SUB AmigaA STATIC
  144. SHARED iBase
  145.   POKEW iBase + 790, &H0
  146.   POKEW iBase + 792, &HF0
  147.   POKEW iBase + 794, &H1F0
  148.   POKEW iBase + 796, &H3F0      
  149.   POKEW iBase + 798, &H770
  150.   POKEW iBase + 800, &HFF0
  151.   POKEW iBase + 802, &H1C70
  152.   POKEW iBase + 804, &H7CF8
  153. END SUB
  154.  
  155. '=======================================
  156.  
  157.